home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
online
/
motor.EXE
/
ARDAS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-04
|
10KB
|
264 lines
begin
write('ѥ');
end.
cord
x1,y1,x2,y2,group:integer;
end;
poin=record
x,y :longint;
index:string[10];
end;
points=array [1..2200] of poin;
var
min,miny: integer;
point:points;
f1,f2,f3,f4,f5 :text;
number:integer;
count:integer;
getx,gety :integer;
counth,countv:integer;
x1limit,x2limit,y1limit,y2limit :integer;
i,j,d1,d2 :integer;
rec :string[10];
ylocation,xlocation :integer;
x1,x2,y1,y2 :string[5];
temp:real;
groupv,grouph :longint;
grdriver,grmode :integer;
horz,ver,lines:array[1..200] of lin;
str2,str1,s :string;
temp1 :real;
label 10,20,30;
procedure quicksort(var a: points; Lo,Hi: integer);
procedure sort(l,r: integer);
var
i,j:integer;
x,y: string[10];
xp,yp :poin;
begin
i:=l; j:=r; x:=a[(l+r) DIV 2].index;
repeat
while a[i].index<x do i:=i+1;
while x<a[j].index do j:=j-1;
if i<=j then
begin
yp:=a[i];
a[i]:=a[j];
a[j]:=yp;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin {quicksort};
sort(Lo,Hi);
end;
begin
min:=29999;
miny:=29999;
assign(f5,'dosya.dat');reset(f5);readln(f5,s);
assign(f1,s+'.dxf');
reset(f1);
str2:='';
count:=0;
{****** READLN ****}
{****** READLN ****}
{****** READLN ****}
while str2 <> 'ENDSEC' do
begin
readln(f1,str2);
if str2='ENTITIES' then
begin
readln(f1,str2);
rec:='start';
end;
if rec='start' then
begin
readln(f1,str2);
if str2='LINE' then
begin
count:=count+1;
readln(f1,str2);
readln(f1,str2);
readln(f1,str2);
readln(f1,x1);
readln(f1,str2);
readln(f1,y1);
readln(f1,str2);
readln(f1,x2);
readln(f1,str2);
readln(f1,y2);
val(x1,lines[count].x1,i);
val(y1,lines[count].y1,i);
val(x2,lines[count].x2,i);
val(y2,lines[count].y2,i);
end;
end;
end;
counth:=0;
countv:=0;
for d1:=1 to count do
begin
if (lines[d1].x1-lines[d1].x2)=0 then
begin
countv:=countv+1;
ver[countv].x1:=lines[d1].x1;
ver[countv].y1:=lines[d1].y1;
ver[countv].x2:=lines[d1].x2;
ver[countv].y2:=lines[d1].y2;
end;
if (lines[d1].y1-lines[d1].y2)= 0 then
begin
counth:=counth+1;
horz[counth].x1:=lines[d1].x1;
horz[counth].y1:=lines[d1].y1;
horz[counth].x2:=lines[d1].x2;
horz[counth].y2:=lines[d1].y2;
end;
end;
{******Points******}
i:=0;
for d2:=1 to counth do
begin
for d1:=1 to countv do
begin
if (ver[d1].y2 > ver[d1].y1) and (horz[d2].x2 > horz[d2].x1) then
if (ver[d1].x1 >= horz[d2].x1) and (ver[d1].x1 <= horz[d2]. x2 ) and
(horz[d2].y1 >= ver[d1].y1) and (horz[d2].y1 <=ver[d1].y2) then
begin
i:=i+1;
point[i].x:=ver[d1].x1;
point[i].y:=horz[d2].y1;
end;
if (ver[d1].y2 < ver[d1].y1) and (horz[d2].x2 > horz[d2].x1) then
if (ver[d1].x1 >= horz[d2].x1) and (ver[d1].x1 <= horz[d2]. x2 ) and
(horz[d2].y1 <= ver[d1].y1) and (horz[d2].y1 >=ver[d1].y2) then
begin
i:=i+1;
point[i].x:=ver[d1].x1;
point[i].y:=horz[d2].y1;
end;
if (ver[d1].y2 > ver[d1].y1) and (horz[d2].x2 < horz[d2].x1) then
if (ver[d1].x1 <= horz[d2].x1) and (ver[d1].x1 >= horz[d2]. x2 ) and
(horz[d2].y1 >= ver[d1].y1) and (horz[d2].y1 <=ver[d1].y2) then
begin
i:=i+1;
point[i].x:=ver[d1].x1;
point[i].y:=horz[d2].y1;
end;
if (ver[d1].y2 < ver[d1].y1) and (horz[d2].x2 < horz[d2].x1) then
if (ver[d1].x1 <= horz[d2].x1) and (ver[d1].x1 >= horz[d2]. x2 ) and
(horz[d2].y1 <= ver[d1].y1) and (horz[d2].y1 >=ver[d1].y2) then
begin
i:=i+1;
point[i].x:=ver[d1].x1;
point[i].y:=horz[d2].y1;
if point[i].x < min then
min:=point[i].x;
if point[i].y < miny then
miny:=point[i].y;
end;
end;
end;
str(counth,str1);
{******INDEX VARIABLE******}
for j:=1 to i do
begin
temp:=((point[j].y-miny)*10000+(point[j].x-min));
str(temp:6:3,str1);
point[j].index:=str1;
end;
quicksort(point,1,i);
for d1:=1 to count do
begin
end;
for d1:=1 to i do
begin
str(d1,str1);
end;
close(f1);
assign(f2,s+'c.dxf');
rewrite(f2);
writeln(f2,' 0');
writeln(f2,'SECTION');
writeln(f2,' 2');
writeln(f2,'ENTITIES');
writeln(f2,' 0');
for d1:=1 to count do
begin
writeln(f2,'LINE');
writeln(f2,' 8');
writeln(f2,'0');
writeln(f2,' 10');
str(lines[d1].x1:0,str1);
writeln(f2,str1);
writeln(f2,' 20');
str(lines[d1].y1:0,str1);
writeln(f2,str1);
writeln(f2,' 11');
str(lines[d1].x2,str1);
writeln(f2,str1);
writeln(f2,' 21');
str(lines[d1].y2,str1);
writeln(f2,str1);
writeln(f2,' 0');
end;
for d1:=i downto 1 do
begin
writeln(f2,'TEXT');
writeln(f2,' 8');
writeln(f2,'0');
writeln(f2,' 10');
str(point[d1].x+2,str1);
writeln(f2,str1);
writeln(f2,' 20');
str(point[d1].y-12:0,str1);
writeln(f2,str1);
writeln(f2,' 40');
writeln(f2,'10');
writeln(f2,' 1');
str(i-d1+1,str1);
writeln(f2,str1);
writeln(f2,' 0');
end;
writeln(f2,'ENDSEC');
writeln(f2,' 0');
writeln(f2,'EOF');
close(f2);
end.uses crt;
type
lin=record
x1,y1,x2,y2,group:integer;
end;
poin=record
x,y :longint;
index:string[10];
end;
points=array [1..2200] of poin;
var
min,miny: integer;
point:points;
f1,f2,f3,f4,f